home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / CHECKBIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.4 KB  |  128 lines
  1. { checkbit.pas -- Use custom checkmarks in menus }
  2.  
  3. program CheckBit;
  4.  
  5. {$R checkbit.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;    { Menu resource ID name }
  12.   cm_Item1 = 101;    { Item 1 command ID value }
  13.   cm_Item2 = 102;    { Item 2 command ID value }
  14.   cm_Item3 = 103;    { Item 3 command ID value }
  15.   cm_Item4 = 104;    { Item 4 command ID value }
  16.   cm_Quit  = 105;    { Exit command ID value }
  17.  
  18.   Checkmark: array[0 .. 27] of Byte = (
  19.     $ff, $ff, { 1111 1111 1111 1111 }
  20.     $87, $c7, { 1000 0111 1100 0111 }
  21.     $c7, $c7, { 1100 0111 1100 0111 }
  22.     $e7, $cf, { 1110 0111 1100 1111 }
  23.     $f3, $9f, { 1111 0011 1001 1111 }
  24.     $f9, $3f, { 1111 1001 0011 1111 }
  25.     $fc, $7f, { 1111 1100 0111 1111 }
  26.     $fc, $7f, { 1111 1100 0111 1111 }
  27.     $f9, $3f, { 1111 1001 0011 1111 }
  28.     $f3, $9f, { 1111 0011 1001 1111 }
  29.     $e7, $cf, { 1110 0111 1100 1111 }
  30.     $c7, $87, { 1100 0111 1000 0111 }
  31.     $83, $ff, { 1000 0011 1111 1111 }
  32.     $ff, $ff  { 1111 1111 1111 1111 }
  33.   );
  34.  
  35. type
  36.  
  37.   CheckBitApplication = object(TApplication)
  38.     procedure InitMainWindow; virtual;
  39.   end;
  40.  
  41.   PCheckBitWindow = ^CheckBitWindow;
  42.   CheckBitWindow = object(TWindow)
  43.     CheckBits: HBitmap;
  44.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  45.     destructor Done;
  46.       virtual;
  47.     procedure WMCommand(var Msg: TMessage);
  48.       virtual wm_First + wm_Command;
  49.   end;
  50.  
  51.  
  52. {- Toggle a checkmarked menu item on or off }
  53. procedure ToggleCheck(Menu: HMenu; MenuItemID: Word);
  54. var
  55.   MAttr, WCheck: Word;
  56. begin
  57.   MAttr := GetMenuState(Menu, MenuItemID, mf_ByCommand);
  58.   if (MAttr and mf_Checked) = mf_Checked then
  59.     WCheck := mf_ByCommand or mf_Unchecked
  60.   else
  61.     WCheck := mf_ByCommand or mf_Checked;
  62.   CheckMenuItem(Menu, MenuItemID, WCheck)
  63. end;
  64.  
  65.  
  66. { CheckBitApplication }
  67.  
  68. {- Initialize CheckBitApplication object's window }
  69. procedure CheckBitApplication.InitMainWindow;
  70. begin
  71.   MainWindow := New(PCheckBitWindow, Init(nil, 'CheckBit'))
  72. end;
  73.  
  74.  
  75. { CheckBitWindow }
  76.  
  77. {- Construct CheckBitWindow object }
  78. constructor CheckBitWindow.Init(AParent: PWindowsObject;
  79.   ATitle: PChar);
  80. var
  81.   Mh : HMenu;
  82. begin
  83.   TWindow.Init(AParent, ATitle);
  84.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  85.   CheckBits := CreateBitmap(14, 14, 1, 1, @checkmark);
  86.   Mh := GetSubMenu(Attr.Menu, 0);
  87.   SetMenuItemBitmaps(Mh, cm_Item1, mf_ByCommand, 0, CheckBits);
  88.   SetMenuItemBitmaps(Mh, cm_Item2, mf_ByCommand, 0, CheckBits);
  89.   SetMenuItemBitmaps(Mh, cm_Item3, mf_ByCommand, 0, CheckBits);
  90. (*  SetMenuItemBitmaps(Mh, cm_Item4, mf_ByCommand, 0, CheckBits) *)
  91. end;
  92.  
  93. {- Destroy CheckBitWindow object and checkmark bitmap}
  94. destructor CheckBitWindow.Done;
  95. begin
  96.   DeleteObject(CheckBits);
  97.   TWindow.Done
  98. end;
  99.  
  100. {- Intercept all wm_SysCommand messages }
  101. procedure CheckBitWindow.WMCommand(var Msg: TMessage);
  102. begin
  103.   case Msg.WParam of
  104.     cm_Item1 .. cm_Item4:
  105.       ToggleCheck(Attr.Menu, Msg.WParam);
  106.     cm_Quit:
  107.       CloseWindow;
  108.   else
  109.     TWindow.WMCommand(Msg)
  110.   end
  111. end;
  112.  
  113. var
  114.  
  115.   CheckBitApp: CheckBitApplication;
  116.  
  117. begin
  118.   CheckBitApp.Init('CheckBitApp');
  119.   CheckBitApp.Run;
  120.   CheckBitApp.Done
  121. end.
  122.  
  123.  
  124. {--------------------------------------------------------------
  125.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  126.   Revision 1.00    Date: 2/27/1991
  127. ---------------------------------------------------------------}
  128.